; reltest.asm - Test program for relative file handling
;

	.include "vicrom.inc"
	
	LFN_CMD = 15
	CHN_CMD = 15

	LFN_REL = 2
	CHN_REL = 2
	
	REC_SIZE = 3
	REC_CNT = 5

	.segment "ZEROPAGE"
	
reg0:		.res 1
reg1:		.res 1
ptr:		.res 2

	.segment "RODATA"

init_msg:	.byte "init drive", 13, 0
qdrive:		.byte "drive#? ",0
nodrive:	.byte "no drive", 13, 0
errout:		.byte "?drive error", 13, 0
drelmsg:	.byte "deleting relfile", 13, 0	
orelmsg:	.byte "opening relfile", 13, 0
wrecmsg:	.byte "writing rec#"
wrecno:		.byte 0, 13, 0
firstmsg:	.byte "rewind", 13, 0	
rrecmsg:	.byte "reading rec#"
rrecno:		.byte 0, 13, 0

orelfile:	.byte "relfile,l,", REC_SIZE
	orflen = * - orelfile
			.byte 0
srelfile:	.byte "s:relfile", 0
ui_text:	.byte "ui"
	ui_len = * - ui_text 

firstrec:	.byte "p", CHN_REL, 1, 0, 1, 13
	fr_len = * - firstrec

	.segment "BASIC"

; Startup Basic program "2011 SYS prolog"
			.word	basprg
basprg:		.word	@end
			.word	2011
			.byte	$9E
			.byte	<(reltest / 1000 .mod 10) + $30
			.byte	<(reltest / 100 .mod 10) + $30
			.byte	<(reltest / 10 .mod 10) + $30
			.byte	<(reltest / 1 .mod 10) + $30
			.byte	0
@end:		.word	0

	.segment "CODE"
	
reltest:	; ask for drive no
			lda #<qdrive
			ldy #>qdrive
			jsr STROUT
			jsr getnum
			sta $BA
			; reset & read error
			lda #<init_msg
			ldy #>init_msg
			jsr STROUT
			lda #ui_len
			ldx #<ui_text
			ldy #>ui_text
			jsr SETNAM
			lda #LFN_CMD	; LFN
			ldx $BA
			ldy #CHN_CMD	; secondary address
			jsr SETLFS
			jsr OPEN
			jsr geterr
			bcs @nodrive
			cmp #73
			bne fail
			; command channel open & ready
			jmp testrel
			
@nodrive:	jsr CLALL
			lda #<nodrive
			ldy #>nodrive
			jsr STROUT
			rts
			
fail:		jsr CLALL
			lda #<nodrive
			ldy #>nodrive
			jsr STROUT
showerr:	lda #<errbuf
			ldy #>errbuf
			jsr STROUT
			sec
			rts

delrel:		; delete file if it exists
			lda #<drelmsg
			ldy #>drelmsg
			jsr STROUT
			ldx #LFN_CMD
			jsr CKOUT
			lda #<srelfile
			ldy #>srelfile
			jsr STROUT
			jsr geterr
			cmp #2
			bcs showerr 
			rts
			
openrel:	; open rel file
			lda #<orelmsg
			ldy #>orelmsg
			jsr STROUT
			lda #orflen
			ldx #<orelfile
			ldy #>orelfile
			jsr SETNAM
			lda #LFN_REL	; LFN
			ldx $BA
			ldy #CHN_REL	; secondary address
			jsr SETLFS
			jsr OPEN
			jsr geterr
			cmp #2
			bcs showerr 
			rts

testrel:	jsr delrel
			jsr openrel
			; set position to first record
;			jsr rewind
			; generate a few records with increasing length
			lda #'a'
			sta reg0
			lda #1
			sta reg1
@recloop:	clc				; print rec msg
			adc #'0'
			sta wrecno
			lda #<wrecmsg
			ldy #>wrecmsg
			jsr STROUT
			ldx #LFN_REL	; start record
			jsr CKOUT
			ldy reg1
@wrloop:	lda reg0
			jsr BSOUT
			inc reg0
			dey
			bne @wrloop
			jsr CLRCH		; end record 									
			inc reg1
			lda reg1
			cmp #REC_CNT+1
			bcc @recloop
			; records written, read error channel
			jsr geterr
			lda #<errbuf
			ldy #>errbuf
			jsr STROUT
			; close file & reopen
			lda #LFN_REL
			jsr CLOSE
			jsr openrel
			; set position to first record
			jsr rewind
			; read records written +1 (2 bytes each)
			lda #0
			sta reg1
@irloop:	clc				; print rec msg
			adc #'1'
			sta rrecno
			lda #<rrecmsg
			ldy #>rrecmsg
			jsr STROUT
			lda #0				; start record
			sta inpos
			ldx #CHN_REL		
			jsr CHKIN
@rdloop:	jsr BASIN			; rec
			ldx inpos
			sta inbuf, x
			inx
			stx inpos
			jsr READSS
			bne @done
			cpx #INBUF_MAX+REC_SIZE
			bcc @rdloop
@done:		jsr CLRCH			; end record
			ldx inpos
			lda #13
			sta inbuf, x
			inx
			lda #0
			sta inbuf, x
			lda #<inbuf			; print record
			ldy #>inbuf
			jsr STROUT
			inc reg1
			lda reg1
			cmp #REC_CNT+2
			bcc @irloop
			jsr geterr
			; records read, read error channel
			jsr geterr
			lda #<errbuf
			ldy #>errbuf
			jsr STROUT
			lda #LFN_REL
			jmp CLOSE

rewind:		; set position to first record and print result
			lda #<firstmsg
			ldy #>firstmsg
			jsr STROUT
			lda #fr_len
			ldx #<firstrec
			ldy #>firstrec
			jsr outcmd
			jsr geterr
			lda #<errbuf
			ldy #>errbuf
			jmp STROUT
			
outcmd:		; A ..  cmd len, X/Y ... command
			stx ptr
			sty ptr+1
			sta reg0
			ldx #LFN_CMD
			jsr CKOUT
			ldy #0
			sta reg1
@outlp:		lda (ptr),y
			jsr BSOUT
			inc reg1
			ldy reg1
			cpy reg0
			bcc @outlp
			jsr CLRCH
			jmp geterr

	.segment "DATA"

	INBUF_MAX = 2

inbuf:		.res INBUF_MAX+REC_SIZE+2
inpos:		.byte 0
	
	.segment "CODE"	
			
getnum:		; get numeric input from user
			lda #0
			sta inpos
@inloop:	lda $C6
			beq @inloop
			sei
			jsr GETKBC
			cmp #$3A		; less or equal '9'?
			bcs @inloop
			cmp #$30		; greater than '0' ?
			bcs @addig
			cmp #$14		; backspace?
			beq @del
			cmp #$0D		; return?
			beq @enter
			bne @inloop
@del:		ldx inpos		; current position?
			beq @inloop
			dec inpos
@outch:		jsr CHROUT
			jmp @inloop
@addig:		ldx inpos
			cpx #INBUF_MAX
			bcs @inloop
			inc inpos
			tay
			sec
			sbc #$30
			sta inbuf, x
			tya
			bcs @outch			
@enter:		jsr CHROUT
			lda #0			; dec to number (A)
			tax
@cnvlp:		cpx inpos
			bcs @done
			asl A
			sta reg0
			asl A
			asl A
			adc reg0
			adc inbuf, x
			inx
			bne @cnvlp						 
@done:		rts

	.segment "DATA"

errpos:		.res 1
errbuf:		.res 80	
	
	.segment "CODE"
			
geterr:		lda #0
			sta errpos
			ldx #LFN_CMD
			jsr CHKIN
@rdloop:	jsr READSS
			bne @eof
			jsr BASIN
			bcs @eof
			ldx errpos
			inc errpos
			sta errbuf, x
			jmp @rdloop
@eof:		jsr CLRCH
			ldx errpos
			cpx #2
			bcc @err
			lda #0
			sta errbuf, x
			lda errbuf
			sbc #$30
			tax
			lda dec_table, x
			clc
			adc errbuf+1
			sec
			sbc #$30
			clc	
			rts
			
@err:		sec
			rts

	.segment "RODATA"

dec_table:	.byte 0, 10, 20, 30, 40 ,50, 60, 70, 80, 90 
